COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE MPRFAI
C00025 ENDMK
C⊗;
	TITLE MPRFAI
	ENTRY MPRFAI,PSRT
	EXTERNAL DL,FRMT,.COMM.,XRN,ALF,STF,POSI,PTR,DPY,FONT,PLTR,CIRCLE
	EXTERNAL PLOT,ALPHA,NOTWRT,METER,SLUR,NOTWRT,ROFF,RHORZ,RESET
	EXTERNAL ITMSUB,GETEXT,EXTIN,BEAMX,TOOMCH,ENDIT,STAFF,LIMIT
	EXTERNAL KSIG,MAKNUM,CLEFS,UNKNWN,ILLEGL,CENTX,RUNTHR,PLTCMD
;	IMPLICIT INTEGER(A-Q,S-Z)
;	REAL DIS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2,TOTAL
;	COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
;					   ↓↓↓↓↓ V IS FOR READIN ONLY
;	COMMON  /XRN/RN(3000),V(1000) /ALF/INP(72),ML
;	1 /STF/RSTFAC(-3/4),RSTJ2  /POSI/STFF(-3/4),JJ2,POS
;	1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
;	1/PLTR/PLT,RHT,DIS,XDIS
;	EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3)),(POS,IPOS)
;	1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8)),(RX3,RJQ(20))
;	1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
;	DATA IP/'P'/,FA1/'( A1)'/

MM←1↔NN←2↔J←3↔LL←4↔ AA←6↔Y←7↔V←10 ↔R←12↔RN←13↔K←14↔RB←15↔KK←11↔SY←5

MPRFAI:	0
	SETZM ITMS#		;	ITMS=0
	SETZM TOTAL 		;	TOTAL=0
	MOVN [999.0]		;	RPLT=-999.
	MOVEM RPLT#		;  RPLT WILL BE FOR HEAVY STAFF LINES.
;;MP23:	JSA 16,RESET		;23	TYPE 21
;;	K#			;21	FORMAT(' RESET BOTTOM? '$)
;;	MOVE K			;	ACCEPT FA1,K
;;	CAMN [ASCII/A    /]		;	IF(K.EQ.'A')GO TO 124
;;	JRST MP124		;	IF(K.EQ.'P')GO TO 123
		  ;TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
;;	CAMN [ASCII/P    /]
;;	JRST MP123
;;	JRST MP24		;	GO TO 24
;;MP123:	SETOM FONT		;123	JFONT=-1
;;	JRST MP23		;GO TO 23
;;MP124:	SETZM FONT		;124	JFONT=0
;;	JRST MP23		;	GO TO 23
;;MP24:	CAMN [ASCII/N    /]	;24	IF(K.EQ.'N')GO TO 22
;;	JRST MP22	; 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
  			; STARTING PEN POS.
			; 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
;;	MOVN [999.0]	;	TOP2=-999
;;	MOVEM TOP2
;;	SETZM RNOMOV#	;	RNOMOV=0
MP22:	SETZM ALF	;22	I1=0
		;RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
MP2:	MOVE [999.0]		;2	TOP=-999
	MOVNM DPY+1
	MOVEM DPY+2		;	BOT=999
MP20:	SETZM PLTR		;20	PLT=0
	SETZM PLOTIT#		;	PLOTIT=0
	SETOM EDX#		;	EDX=-1
	MOVEI 1			;	M=1
	MOVEM LIMIT+4
;;	MOVEM PTR+=253
	JRST MP5504		;	GO TO 5504


MP11:	JSA 16,NOTWRT		;11	CALL NOTWRT
MP57:	SKIPGE PLTR		;57	IF(PLT)GO TO 6120
	JRST MP6120
	AOS LIMIT+1		;	ITEM=ITEM+1
;;	AOS PTR+=250		;	ITEM=ITEM+1
	SKIPGE EDX		;	IF(EDX.EQ.-1)GO TO 77
	JRST MP77
	MOVE LIMIT+=4 		; M	IF(M.LT.I)GO TO 6120
	CAMGE LIMIT+=3 		; I
;;	MOVE PTR+=253		; M	IF(M.LT.I)GO TO 6120
;;	CAMGE PTR+=252		; I
	JRST MP6120
MP77:	MOVN PLOTIT		;77	IF(PLOTIT.EQ.-2)GO TO 2311
	CAIN 2
	JRST MP2311
MP5504:	MOVE [ASCII/P    /]	;5504	IF(I1.EQ.IP)GO TO 2311
	CAMN ALF
	JRST MP2311
	MOVEM ALF		;	I1=IP
	MOVE [ASCII/%    /]    ;INP(2)='%' FLAG FOR 1ST TIME IN PLTCMD
;;;	MOVE [ASCII/X    /]	;	INP(2)='X'
	MOVEM ALF+1
MP311:	SETZM .COMM.+1		;311	JA=0
MP2311:	SETZM NOSET
	JSA 16,PLTCMD		;2311	CALL PLTCMD(NOSET)
	JUMP NOSET#
	MOVN ALF+1		;	IF(INP(2).EQ.-1)GO TO 30
	CAIN 1
	JRST MP30		; **** END OF DATA ***
	SKIPN PLOTIT		;	IF(PLOTIT.EQ.0)GO TO 3005
	JRST MP3005
	MOVE [ASCII/P    /]	;	I1=IP
	MOVEM ALF
	SETOM PLOTIT		;	PLOTIT=-1

       	MOVEI 1			;6531	M=1
	MOVEM LIMIT+=4 
;;	MOVEM PTR+=253
	SETOM EDX		;	EDX=-1
	SETZ 2,			;	DO 5532 K=1,9
MP5532:	KIFIX .COMM.+4(2)	;5532	JQ(K)=RJQ(K)
	MOVEM .COMM.+=24(2)
	CAIE 2,=8
	AOJA 2,MP5532
	MOVNI 1			;	IF(PLOTIT.EQ.-1)GO TO 5121
	CAMN PLOTIT
	JRST MP5121
MP590:	SETZM ALF		;590	I1=0
				; TO RUN THROUGH DATA.
	MOVE [999.0]		;	TOP=-999
	MOVNM DPY+1
	MOVEM DPY+2		;	BOT=999
				;GOES TO PLOTTER
MP85:	MOVEI 1			;85	M=1
	MOVEM LIMIT+=4
	SETZM LIMIT+=1 		;	ITEM=0
;;	MOVEM PTR+=253	
;;	SETZM PTR+=250		;	ITEM=0
	MOVEM PLTR		;8852	PLT=1
	SETZM EDX		;	EDX=0
	JRST MP6120		;	GO TO 6120

MP30:	MOVE TOTAL		;30	A=TOTAL/200.0
	FDVR [200.0]		;	TYPE 300,A,ITMS
	MOVEM K#		;	CALL PLOT(0,0,99)
	JSA 16,ENDIT		;  THE END OF THE DATA
	JUMP K			;300	FORMAT(F7.2,' INCHES',I,' ITEMS')
	JUMP ITMS#

MP60:	KIFIX 2,.COMM.		;60	J2=R2
	MOVEM 2,.COMM.+3
	CAIL 2,8			;	IF(J2.LT.5)GO TO 16
;%%%%	CAIL 2,5			;	IF(J2.LT.5)GO TO 16
	JRST MP160 		;IF(J2.GT.-4)GO TO 16
	JUMPGE 2,MP16	;	IF J2 < 0 TYPE 160,J2
;%%%%%	CAMLE 2,[-4]		;	TYPE 160,J2
;%%%%%	JRST MP16
MP160:	JSA 16,ILLEGL		;	GO TO 57
	JUMP .COMM.+3		;160	FORMAT(' ILLEGAL STAFF# ',I4)
	JRST MP57
MP16:	MOVE STF(2)		;16	RSTJ2=RSTFAC(J2)   %%%%%% WAS +3(2)
	MOVEM STF+10
	MOVE POSI(2)		;%%%%%%% WAS +3(2)
	MOVEM POSI+11		;	5541	POS=STFF(J2)
	MOVE .COMM.+1		;	IF(JA.NE.16)GO TO 61
	CAIE =16
	JRST MP61
	MOVE .COMM.+6		;	IF(R5.GE.100)R5=R5-100
	CAMGE [100.0]	;>100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP PARTS  
	JRST .+3
	FSBR [100.0]
	MOVEM .COMM.+6		; R5
	MOVE .COMM.+=31		;	IF(J10.NE.1)GO TO 62
	CAIE 1
	JRST MP62
	MOVE RWD3		;	R3=RWD3
	MOVEM .COMM.+4		;C  POSITIONS TEXT ITEMS.
MP62:	MOVE .COMM.+6		;62	RWD3=R5*RSTJ2*R9+R3
	FMPR STF+10		;RSTJ2
	FMPR .COMM.+=10		;R9
	FADR .COMM.+4		;R3
	MOVEM RWD3
MP61:	MOVE .COMM.+4		;61	RX3=R3
	MOVEM .COMM.+=23
	JSA 16,RHORZ
	JUMP .COMM.+4		;	J3=ROFF(RHORZ(R3))
	JSA 16,ROFF		;C  LINE IS DIVIDED INTO 200 POINTS.
	JUMP 0
	KIFIX
	MOVEM .COMM.+=24	; J3
	JSA 16,CENTX		;	CALL CENTX
	FLTR .COMM.+=24	 ; SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
	MOVEM .COMM.+4		;	R3=J3
	MOVE 2,.COMM.+1		;	IF(JA.LE.2)GO TO 11
	CAIL 2,=19		;IF(JA.GT.18)CALL UNKNWN(JA)
	JRST MP5700
	JRST .@(2)
	MP11
	MP11
	MP68
	MP25
	MP67

	MP625		;JA=6
	MP116
	MP125
	MP11
	MP69		;JA=10
	
	MP68
	MP12
TOTAL:	0			;JA NEVER =13,14,15
RWD3:	0
TOP2:	0
	MP116
	MP81		;JA=17
;551	GO TO(11,11,68,25,67, 625,116,125,11,69, 68,67),JA
	MP80
MP80:	JSA 16,METER		;	GO TO (116,81,80),JA-15
	JRST MP57	;C  FOR 16,17,18 (WORDS, KSIG, METER)
MP5700:	JSA 16,UNKNWN		;	TYPE 5700,JA
	JUMP .COMM.+1		;5700	FORMAT(' UNKNOWN CODE=',I3)
	JRST MP57		;	GO TO 57
			;TRAP FOR UNKNOWN CODE #S (SUCH AS 99-FOR "NO KSIG".

MP69:	JSA 16,MAKNUM		;69	CALL MAKNUM(R5)
	JUMP .COMM.+6		;	GO TO 57
	JRST MP57
MP68:	JSA 16,CLEFS		;68	CALL CLEFS
	JRST MP57		;	GO TO 57

MP67:	JSA 16,SLUR		;67	CALL SLUR
	JRST MP57		;	GO TO 57

MP116:	JSA 16,ALPHA		;116	CALL ALPHA
	JRST MP57		;	GO TO 57

MP81:	JSA 16,KSIG		;81	CALL KSIG
	JRST MP57		;	GO TO 57

MP12:	JSA 16,CIRCLE
	JRST MP57		;80	CALL METER
	         		;	GO TO 57
MP125:	SKIPE .COMM.		;125	IF(R2.EQ.0)RMOV=R8
	JRST .+3  
	MOVE .COMM.+=9
	MOVEM RMOV#
	JSA 16,STAFF
	JRST MP57
MP625:	JSA 16,BEAMX		;625	CALL BMSTF
				; BEAMS AND STAVES
	JRST MP57		;	GO TO 57

MP25:	JSA 16,ITMSUB		;25	CALL ITMSUB
			;  BAR LINES AND SEVERAL OTHER KINDS OF LINES.
	JRST MP57		;	GO TO 57

MP3005:	MOVN [999.0]		;3005	IF(RPLT.EQ.-999.)RPLT=R9
	CAME RPLT		;C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
	JRST .+3
	MOVE .COMM.+=10
	MOVEM RPLT
   	MOVNI 2			;	PLOTIT=-2
   	MOVEM PLOTIT
	SKIPN ITMS		;FIRST TIME CHECK FOR NOSET FLAG
	SKIPE NOSET		;NOSET=-1 IF NOSET IS ON
	JRST GETEM
  	MOVN [999.0]		;	TOP2=-999
  	MOVEM TOP2
  	SETZM RNOMOV#		;	RNOMOV=0
GETEM:	JSA 16,GETEXT		;	CALL GETEXT(NAME,EXT)
	JUMP DL+2			;C  JUMP TO READ BIG FILES
	JUMP DL+3
	JSA 16,EXTIN		;	CALL EXTIN(RSTFAC,128)
	JUMP STF
	JUMP [=128]

	JSA 16,EXTIN		;	CALL EXTIN(PWDS,JJ2)
	JUMP  PTR
	JUMP POSI+10

;;	JSA 16,TTT
;;	POSI+10
;;	POSI+11
	JSA 16,EXTIN		;	CALL EXTIN(RN,IPOS)
	JUMP XRN
	JUMP POSI+11
	MOVE POSI+10		;	ITEM=JJ2-2
	SUBI 2
	MOVEM LIMIT+=1 
;;	MOVEM PTR+=250
	ADDM ITMS		;	ITMS=ITMS+ITEM
	MOVE POSI+11		;	I=IPOS
	MOVEM LIMIT+=3 
;;	MOVEM PTR+=252
;;	CAIG =2500		;2203	IF(I.LE.2500)GO TO 590
	CAIG =3000		;2203	IF(I.LE.3000)GO TO 590
;;	CAIG =2000		;2203	IF(I.LE.2000)GO TO 590
	JRST MP590
	JSA 16,TOOMCH		;	TYPE 4202,I
	JUMP LIMIT+2			;	STOP
			;4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
MP121:	SKIPN PLOTIT		;121	IF(PLOTIT.EQ.0)GO TO 5504
	JRST MP5504
MP5121:	JSA 16,PSRT  		;5121	CALL PLTSRT
	SETOM PLTR	;IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
;;;;;;;;;;; HEAVY STAFF LINE FEATURE DISABLED 7/23/79 ;;;;;;;;;;;;;;
;;;	SKIPE RPLT		;	PLT=-1
;;;	SOS PLTR		;	IF(RPLT.NE.0)PLT=-2
;;;;;;;;;;; HEAVY STAFF LINE FEATURE DISABLED 7/23/79 ;;;;;;;;;;;;;;
	        		;C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
	MOVE  2,.COMM.
	FMPR 2,[1.24]		;	DIS=R2*1.24
	MOVEM 2,PLTR+2
	MOVE [1.0]
	FDVR 2
	MOVEM PLTR+3		;	XDIS=1/DIS
	MOVE .COMM.+4		;	RHT=R3*1.2
	FMPR [1.2]		;1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
	MOVEM PLTR+1

	MOVE 3,RMOV		;FIRST TIME RMOV=0 OR +
	JUMPN 3,TOTL1		; 	IF(RMOV.NE.0)GO TO TOTL1
;;	SKIPE TOTAL
;;	JRST TOTL1
	SETO 3,			; SET AC3 (FLAG) TO -1
	MOVE 2,DPY+1		;**** IF(RMOV.EQ.0)TOTAL=TOTAL+(TOP-BOT)*RHT
	FSBR 2,DPY+2
	FMPR 2,PLTR+1
	FADRM 2,TOTAL		;TOTAL=TOTAL IMAGE LENGTH (IN 200THS INCH)

TOTL1:	FMPR DPY+2		;A=BOT*RHT
	MOVEM A#		;??????
	MOVNM DPY+2		;	BOT=-A
	JUMPL  3,TOTL2		;	IF(AC3.LT.0)GO TO TOTL2
	SKIPLE RMOV		;	IF(RMOV.GT.0)GO TO TOTL3
	JRST .+3
  	SKIPN TOTAL		;	IF(TOTAL.EQ.0)TOTAL=BOT
  	MOVNM TOTAL
  	MOVE PLTR+1		;TOTL3:	TOTAL=TOTAL+TOP*RHT
  	FMPR DPY+1
  	FADRM TOTAL	     ;TOTAL includes BOT with first file only.
TOTL2:	MOVN [999.0]		;	IF(TOP2.EQ.-999)GO TO 8121
	CAMN TOP2
	JRST MP8121
	MOVE 2,TOP2		;	BOT=BOT+TOP2
	FADRM 2,DPY+2
	SKIPN TOP2		;	IF(TOP2.EQ.0)BOT=0
	SETZM DPY+2
	MOVE DPY+2
	MOVEM A			;	A=BOT
	JRST MP9121		;	GO TO 9121
MP8121:	SETZM RNOMOV		;8121	RNOMOV=0
MP9121:	SKIPE .COMM.+=8		;9121	IF(R7.EQ.0)R7=RMOV
	JRST .+3		;RMOV HAS INCHES FROM P8 OF STAFF 0.
	MOVE RMOV
	MOVEM .COMM.+=8
	MOVE RNOMOV		;	IF(RNOMOV.GT.1)BOT=RNOMOV
	CAMLE [1.0]
	MOVEM DPY+2
	MOVE [200.0]		;	RNOMOV=R6+R7*200.*R3
	FMPR .COMM.+4
	SKIPL .COMM.+=8		;IF(R7.LT.0)SKIP OVER NEXT
	FMPR .COMM.+=8
	FADR .COMM.+7
	MOVEM RNOMOV#
	SETOM RMOV		;	RMOV=-1   THIS IS AFTER 1ST TIME.
;;;;	SETZM RMOV		;	RMOV=0
;  R6=1 FOR NO MOVE AT END.  R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
	SKIPE .COMM.+=26	;C (J4) P4=1 FOR XGP OUTPUT
	JRST MP6120		;	IF(J5.NE.0)GO TO 6120
	KIFIX DPY+2		;C  MOVES 0 POINT OVER EACH TIME.
	MOVEM K			;6121	CALL PLOT(0,IFIX(BOT),-3)
	JSA 16,PLOT		;C  MOVES PLOTTER UP IF P5=0.
	JUMP [0]
	JUMP K
	JUMP [-3]

MP6120:	MOVE LIMIT+=4 		;C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
;;MP6120:	MOVE PTR+=253		;C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
	CAML LIMIT+=3 		;6120	IF(M.GE.I)GO TO 7120
;;	CAML PTR+=252		;6120	IF(M.GE.I)GO TO 7120
	JRST MP7120		;	CALL RUNTHR(M)
	JSA 16,RUNTHR		;	GO TO 60
	JUMP LIMIT+=4 
	JRST MP60
MP7120:	MOVEI 1			;7120	M=1
	MOVEM LIMIT+=4 
;;	MOVEM PTR+=253
	MOVE [50.0]		;71201 	A=50.*RHT
	FMPR PLTR+1
	MOVEM A
	MOVE PLTR+1		;	TOP=TOP*RHT
	FMPRM DPY+1
	SKIPN RNOMOV		;	IF(RNOMOV.EQ.0)GO TO 7122
	JRST MP7122
	SETZM A			;	A=0
MP7121:	MOVE RNOMOV		;7121	IF(RNOMOV.LE.1)GO TO 7123
	CAMG [1.0]
	JRST MP7123
	MOVEM A			;	A=RNOMOV
	FSBR DPY+1		;	TOTAL=TOTAL+A-TOP
	FADRM TOTAL
	JRST MP7123		;	GO TO 7123
MP7122:	MOVE A			;7122	TOTAL=TOTAL+A
	FADRM TOTAL
	FADR DPY+1		;	A=A+TOP
	MOVEM A
MP7123:	KIFIX A			;7123	CALL PLOT(0,IFIX(A),3)
	MOVEM K
	JSA 16,PLOT
	JUMP [0]
	JUMP K
	JUMP [3]
	MOVE RNOMOV		;	IF(RNOMOV.EQ.1)GO TO 20
	CAMN [1.0]		;C  PRESERVES TOP AND BOT IF RNOMOV
	JRST MP20
	MOVE A			;	TOP=A
	MOVEM DPY+1
	MOVEM TOP2		;	TOP2=TOP
	JRST MP2		;	GO TO 2
			;  TO MOVE 'PLOTTER' FOR XGP OUTPUT
			;  MOVES PLOTTER UP
		;  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.

PPP:	BLOCK =350	;THIS WAS 250 - 2/78, 6/78

;;	SUBROUTINE PSRT(P)
;; SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
;;	IMPLICIT INTEGER(S-Z)
;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;;	DIMENSION  P(250) **** AN ARGUMENT, INSTEAD.
PSRT:	0	;	DO 4 K=1,ITEM
	MOVEI	K,PPP		; ADR OF P
	MOVEI	MM,PTR		;L=PWDS(K)
	MOVEI RB,(MM)
	MOVE	NN,LIMIT+1  	; ITEM
;;	MOVE	NN,PTR+=250	; ITEM
	ADDI	NN,-1(MM)		; LAST ADR. OF PWDS
	MOVE SY,[16.0]
PL4:	MOVE	R,(MM)		;LL=PWDS(K-1)
				;LM=PWDS(K+1)
				;A=RN(L+3)
				;P(K)=A+1000*RN(L+2)
	MOVE AA,XRN+2(R)
	MOVE J,XRN+1(R)
	FMPR	J,[=1000.0]
	FADR	J,XRN+2(R)	; IF(RN(L+1).NE.16)GO TO 40
	MOVE V,XRN(R)
	CAME	V,[=8.0]	;IF(RN(L+1).EQ.8)P(X)=P(X)-16
	JRST	PLA
	FSBR	J,[=16.0]
	MOVE	AA,[=1000.0]
PLA:	MOVEM	J,(K)
	CAME V,SY
	JRST	PL40
	CAIN RB,(MM)
	JRST PLAQ		;IF (K.EQ.1) GO TO PLAQ
	MOVE	Y,-1(MM)	;Y=PWDS(K-1)
	CAMN SY,XRN(Y)
	JRST 	PL41
PLAQ:	MOVE	V,1(MM)		;V=PWDS(K+1) ;IF(RN(V+1).EQ.16)GO TO 41
	CAMN SY,XRN(V)
	JRST	PL41
	JRST	PLS		;GO TO 4
PL40:	JUMPGE	AA,PLS 	;40	IF(A.GE.0)GO TO 4
PL41:	MOVN	AA,[=10000.0]	;41	P(K)=-10000
	MOVEM	AA,(K)
PLS:	CAIL	MM,(NN)	;4	CONTINUE
	JRST	PLX
	AOJ	MM,
	AOJA	K,PL4
;  PLOTS ALL NEG. POSITIONS FIRST.
PLX:	MOVE	AA,LIMIT+3  	;IX=I
	MOVEM	AA,LIMIT+4  
	CAIL	AA,=3000		;IF(I.LT.1500)I=1500
;;6/78	CAIL	AA,=1500		;IF(I.LT.1500)I=1500
	JRST 	PLY
	MOVEI	AA,=3000
;;6/78	MOVEI	AA,=1500
	MOVEM	AA,LIMIT+3 
PLY:	MOVEI	Y,(AA)		;	Y=I
	ADD	AA,LIMIT+4 	;I=I+IX-1
	SUBI	AA,1
	MOVEM	AA,LIMIT+3 
	MOVEM	Y,LIMIT+4 	;IX=Y
;  IX IS M IN MAIN PROG.
;  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
PL2:	MOVE	AA,PPP  		;2	A=P(1)
	MOVEI	R,1		;L=1
	MOVEI	J,1
	MOVEI	K,PPP  		;DO 1 K=1,ITEM
	MOVE	NN,LIMIT+1 
	ADDI	NN,(K)	;P(ITEM)
PL1:	CAMG	AA,(K)		;IF(A.LE.P(K))GO TO 1
	JRST	PLZ
	MOVE	AA,(K)		;A=P(K)
	MOVE	R,J		;L=K
PLZ:	CAIL	K,-1(NN)	;1	CONTINUE
	JRST	PLW
	AOJ	K,
	AOJA	J,PL1
PLW:	CAMN	AA,[=10000.0]	;	IF(A.EQ.10000.)RETURN
	JRA	16,(16)
;  ALL ITEMS HAVE NOW BEEN SHUFFLED
	MOVEI	V,PTR		;V=PWDS(L)
	ADDI	V,(R)
	MOVE	V,-1(V)
	MOVE	AA,[=10000.0]	;P(L)=10000
	MOVEI	J,PPP  
	ADDI	J,(R)
	MOVEM	AA,-1(J)
	MOVEI	R,XRN		;L=RN(V)+2+Y
	ADDI	R,(V)
	KIFIX	R,-1(R)
	ADDI	R,2
	ADDI	R,(Y)
	SUBI	V,(Y)		;V=V-Y
	MOVEI	K,XRN		;DO 3 K=Y,L
	ADDI	K,(Y)
	MOVEI	NN,XRN
	ADDI	NN,(R)
PL3:	MOVEI	AA,(K)
	ADDI	AA,(V)		;3	RN(K)=RN(K+V)
	MOVE	AA,-1(AA)
	MOVEM	AA,-1(K)
	CAIGE	K,(NN)
	AOJA	K,PL3
;; REPLACED SUBROUTINE LOOP
	MOVEI	Y,(R)		;Y=L+1
	ADDI	Y,1
	JRST	PL2		;GO TO 2
	END